perm filename PORTS.SAI[PUB,TES] blob
sn#129305 filedate 1974-11-03 generic text, type T, neo UTF8
00100 BEGOF("PORTS")
00200
00300
00400 COMMENT
00500
00600 *** Variations at Different Sites ***
00700
00800 TENEX PUB uses different naming conventions for generated and
00900 intermediate files. ITS at MIT-AI can not open a channel for
01000 successive input and output, as ALFIZE is accustomed to do.
01100
01200 ***
01300
01400 PORTIONs, SENDs, and RECEIVEs.
01500
01600 The PORTYPE records in the ITBL heap include the following fields:
01700 PORCH is the status, keeping track of occurrences of PORTION, INSERT,
01800 SEND, and RECEIVE... in particular, if PORCH>0, then it is the
01900 channel number used for SENDs. PORSEQ is the link to the next portion
02000 in proper collating sequence. PORSTR points to an associated record
02100 in STBL with fields: PORFIL, the file name of the generated file, and
02200 PORINT, the file name of the intermediate file.
02300
02400 The pseudo-portion FOOT is distinguished by a PORCH of -1.
02500
02600 ;
02700
02800 INTEGER SVSHED ; comment, value of SHED before Alphabetizing began ;
02900
03000 PROCEDURES
00100 PUBLIC SIMPLE PROCEDURE PORTS! ;$"#
00200 BEGIN "PORTS!"
00300 UPCAS3←(UPCASE(0)) LOR '3000000 ; COMMENT POINT 7, CHARTBL(3), 6 ;
00400 UPCAS5←(UPCASE(0)) LOR '5000000 ; UPCAS6←(UPCASE(0)) LOR '6000000 ;
00500 FOR J ← 0 THRU 127 DO DPB(J, UPCASE(J)) ;
00600 FOR J ← "a" THRU "z" DO DPB(J-("a"-"A"), UPCASE(J)) ; DPB(J←"!", UPCASE("_")) ;
00700 INTERS ← NPORTS ← THISPORT ← 0 ; PORTLL ← SEQPORT ← PUTI(4, -5) ; PORSEQ(SEQPORT) ← INTER ← -1 ;
00800 PORSTR(SEQPORT) ← PUTS(NULL) ; PUTS(NULL) ;
00900 END "PORTS!" ;
00100 PRIVATE STRING SIMPLE PROCEDURE ALFIZE(STRING FILENAME, LEFTRIGHT) ;$"#
00200 BEGIN "ALFIZE"
00300 INTEGER SVIHIGH, SVSHIGH, CHAN, LEFT, RIGHT, N, I ; STRING S, KEY ;
00400 SVSHED ← SHED ; SVIHIGH ← IHIGH ; SVSHIGH ← SHIGH ;
00500 IF (CHAN←GETCHAN)<0 THEN
00600 BEGIN
00700 WARN(NULL,"No Channel to Alphabetize "&FILENAME) ;
00800 RETURN(NULL) ;
00900 END ;
01000 EOF ← 0 ; OPEN(CHAN, "DSK", 0, 2, IFC ITSVER THENC 0 ELSEC 2 ENDC, 150, BRC, EOF) ;
01100 LOOKUP(CHAN, IFC TENEX THENC IFILENAME & GENEXT & ENDC FILENAME, FLAG) ;
01200 IF FLAG THEN
01300 BEGIN
01400 WARN(NULL,"No Generated file "&FILENAME) ;
01500 RETURN(NULL) ;
01600 END ;
01700 SETBREAK(LOCAL!TABLE, LEFTRIGHT&LF, NULL, "IS") ; LEFT ← LOP(LEFTRIGHT) ; RIGHT ← LOP(LEFTRIGHT) ; N ← 0 ;
01800 DO BEGIN "SENDEE"
01900 S ← INPUT(CHAN, TO!TB!FF!SKIP) ; IF EOF THEN DONE ; S ← S & TB ;
02000 DO S ← S & INPUT(CHAN, LOCAL!TABLE) UNTIL BRC=LEFT OR BRC=LF OR EOF ;
02100 IF BRC = LEFT THEN
02200 BEGIN "KEY"
02300 KEY ← NULL ; S ← S & LEFT ;
02400 DO KEY ← KEY & INPUT(CHAN, LOCAL!TABLE) UNTIL BRC=RIGHT OR BRC=LF OR EOF ;
02500 PUSHS(1,KEY) ; comment, Sort Key in SSTK ;
02600 S ← S & KEY ;
02700 IF BRC = RIGHT THEN
02800 BEGIN
02900 S ← S & RIGHT ;
03000 DO S ← S & INPUT(CHAN, LOCAL!TABLE) UNTIL BRC = LF OR EOF ;
03100 END ;
03200 END "KEY" ;
03300 PUTS(S&LF) ; comment, complete entry in STBL ;
03400 N ← N + 1 ; PUTI(1, N) ; comment, Sort Tags in ITBL ;
03500 END "SENDEE"
03600 UNTIL EOF ;
03700 QUICKERSORT(N, SVIHIGH) ;
03800 CLOSIN(CHAN) ; FILENAME ← IFC TENEX THENC
03900 IFILENAME & ALFEXT & FILENAME ELSEC
04000 FILENAME[1 TO ∞-1] & "Z" ENDC ;
04100 IFC ITSVER THENC OPEN(CHAN, "DSK", 0, 0, 2, 150, BRC, EOF) ; ENDC
04200 ENTER(CHAN, FILENAME, FLAG) ; comment, "---.PUZ" or "---.ALF---";
04300 IF FLAG THEN
04400 BEGIN
04500 WARN(NULL,"ENTER failed for Alphabetized File "&FILENAME) ;
04600 RETURN(NULL) ;
04700 END ;
04800 FOR I ← 1 THRU N DO OUT(CHAN, STBL[SVSHIGH + ITBL[SVIHIGH + I]]) ;
04900 RELEASE(CHAN) ; SHED ← SVSHED ; IHIGH ← SVIHIGH ; SHIGH ← SVSHIGH ; RETURN(FILENAME) ;
05000 END "ALFIZE" ;
00100 PUBLIC SIMPLE PROCEDURE FINPORTION ;$"#
00200 BEGIN
00300 DBREAK ;
00400 IF OLDPGIDA THEN NEXTPAGE ;
00500 END "FINPORTION" ;
00100 PUBLIC SIMPLE PROCEDURE DINSERT ;$"#
00200 BEGIN
00300 INTEGER CHAN, PIX, ROTTEN ;
00400 IF ON THEN BEGIN TES 4/11/74;
00500 FINPORTION ;
00600 IF INTER GEQ 0 THEN
00700 BEGIN FOR DUMMY←1 THRU 5 DO WORDOUT(INTER,-20) ; RELEASE(INTER) ; RELEASE(SINTER) ; SINTER←INTER←-1 END ;
00800 END ;
00900 DO BEGIN "COLLATE"
01000 DPASS ; IF NOT THISISID THEN BEGIN WARN("=","Unnamed INSERT Portion!") ; RETURN END ;
01100 IF ON THEN
01200 BEGIN ROTTEN ← FALSE ;
01300 IF THISTYPE NEQ PORTYPE THEN
01400 BEGIN
01500 BIND(SYMB←DECLARE(SYMB, PORTYPE), PIX ← PUTI(4, -5));
01600 PORSTR(PIX) ← PUTS(NULL) ; PUTS(NULL) ; TES 3/21/74;
01700 END
01800 ELSE IF (CHAN ← PORCH(PIX ← IX)) = -1 THEN BEGIN WARN("=","Can't INSERT FOOT!"); ROTTEN←TRUE END
01900 ELSE IF NOT (0 LEQ CHAN LEQ 15) THEN BEGIN WARN("=","Can't INSERT passed PORTION "&THISWD) ; ROTTEN←TRUE END ;
02000 IF NOT ROTTEN THEN BEGIN PORSEQ(SEQPORT) ← PIX ; PORSEQ(SEQPORT ← PIX) ← -1 END ;
02100 PASS ;
02200 END ;
02300 END "COLLATE" UNTIL NOT ITSCH(<,>) ;
02400 END "DINSERT" ;
00100 PUBLIC SIMPLE PROCEDURE DPORTION ;$"#
00200 BEGIN
00300 INTEGER CHAN, PSIX, PIX ; STRING IFIL ; LABEL WASFWD ;
00400 DPASS ; IF NOT THISISID THEN BEGIN WARN("=","Unnamed PORTION!") ; RETURN END ;
00500 IF NOT ON THEN BEGIN PASS ; RETURN END ;
00600 FINPORTION ;
00700 IF THISTYPE NEQ PORTYPE THEN
00800 BEGIN
00900 BIND(SYMB←DECLARE(SYMB, PORTYPE), PIX ← PUTI(4, -2)) ;
01000 PORSTR(PIX) ← PUTS(NULL) ; PUTS(NULL);
01100 PORSEQ(PIX) ← 0 ;
01200 END
01300 ELSE IF 0 LEQ (CHAN ← PORCH(PIX ← IX)) THEN BEGIN RELEASE(CHAN) ; PORCH(PIX) ← -3 ; GO TO WASFWD END
01400 ELSE IF CHAN = -1 THEN BEGIN WARN("=","Can't declare PORTION FOOT!") ; PASS ; RETURN END
01500 ELSE IF CHAN NEQ -5 THEN WARN("=","PORTION "&THISWD&" already declared!")
01600 ELSE IF PORSEQ(THISPORT) NEQ PIX THEN
01700 BEGIN PORCH(PIX) ← -2 ; COMMENT ADDED FEB 6, 1973 ;
01800 WASFWD: BEGIN
01900 IF INTER GEQ 0 THEN
02000 BEGIN FOR DUMMY←1 THRU 5 DO WORDOUT(INTER,-20) ; RELEASE(INTER) ; RELEASE(SINTER) END ;
02100 INTER ← SINTER ← -1 ;
02200 END ;
02300 END ;
02400 IF INTER < 0 THEN
02500 BEGIN
02600 PSIX ← PORSTR(PIX) ;
02700 IFCR TENEX THENC
02800 IFIL ← CVS(INTERS←INTERS+1) ; PORINT(PSIX) ← IFIL ;
02900 INTER ← WRITEON(TRUE,IFILENAME&OCTEXT&IFIL) ;
03000 SINTER← WRITEON(FALSE,IFILENAME&TXTEXT&IFIL) ;
03100 ELSEC
03200 IFIL ← "PUI"&CVS(INTERS←INTERS+1) ;
03300 PORINT(PSIX)←IFIL ;
03400 INTER←WRITEON(TRUE,IFIL&PUIEXT) ; SINTER←WRITEON(FALSE,IFIL&"S"&PUIEXT) ;
03500 ENDC
03600 END ;
03700 IF PORSEQ(PIX) = 0 THEN
03800 BEGIN
03900 PORSEQ(SEQPORT) ← PIX ;
04000 SEQPORT ← PIX ;
04100 END ;
04200 THISPORT ← PIX ; NPORTS ← NPORTS + 1 ;
04300 PASS ;
04400 END "DPORTION" ;
00100 PUBLIC SIMPLE PROCEDURE DRECEIVE ;$"#
00200 BEGIN
00300 STRING A ;
00400 IF THATISCON AND 1 LEQ LENGTH(THATWD)-1 LEQ 2 THEN BEGIN PASS ; A ← THISWD[2 TO ∞] END
00500 ELSE A ← NULL ;
00600 IF ON THEN RECEIVE(THISPORT, A) ; PASS ;
00700 END "DRECEIVE" ;
00100 PUBLIC SIMPLE PROCEDURE DSEND ;$"#
00200 BEGIN
00300 INTEGER PIX; STRING FI ;
00400 INTEGER SIMPLE PROCEDURE OPORT ;
00500 BEGIN INTEGER CH ; CH←WRITEON(FALSE,
00600 IFCR TENEX THENC IFILENAME&GENEXT&(FI←THISWD) ELSEC
00700 (FI←(CVS(NPORTS←NPORTS+1)&THISWD)[1 TO 5])&PUGEXT ENDC) ;
00800 RETURN(CH) ; END "OPORT" ;
00900 PASS ; IF NOT THISISID THEN BEGIN WARN("=","SEND Where?") ; RETURN END ;
01000 IF NOT ON THEN BEGIN PASS ; DEFN(FALSE, FALSE,0,0) ; RETURN END ;
01100 IF THISTYPE NEQ PORTYPE THEN
01200 BEGIN
01300 BIND(SYMB←DECLARE(SYMB, PORTYPE), PIX ← PUTI(4, OPORT) ) ;
01400 PORSTR(PIX) ← PUTS(NULL) ; PUTS(NULL) ;
01500 PORSEQ(PIX) ← 0 ; PORFIL(PORSTR(PIX)) ← FI ;
01600 END
01700 ELSE IF PORCH(PIX←IX)=-5 THEN
01800 BEGIN PORCH(PIX)←OPORT ; PORFIL(PORSTR(PIX))←FI END ;
01900 PASS ;
02000 SEND(PIX, DEFN(TRUE,PORCH(PIX) NEQ -1,0,0)) ;
02100 END "DSEND" ;
00100 PRIVATE INTEGER SIMPLE PROCEDURE LOG2(INTEGER BINARY) ;$"#
00200 BEGIN "LOG2"
00300 INTEGER I ; I ← 0 ;
00400 WHILE BINARY > 1 DO BEGIN I ← I + 1 ; BINARY ← BINARY DIV 2 END ;
00500 RETURN(I) ;
00600 END "LOG2" ;
00100 PUBLIC SIMPLE PROCEDURE NOPORTION ;$"#
00200 BEGIN "NOPORTION"
00300 STRING IFIL ; INTEGER PSIX, PIX ;
00400 WARN("=","No PORTION Declaration Found") ;
00500 IFIL ← IFC NOT TENEX THENC "PUI"& ENDC CVS(INTERS←INTERS+1) ;
00600 THISPORT ← PIX ← PUTI(4, -2) ;
00700 PORSTR(PIX) ← PSIX ← PUTS(NULL) ; PUTS(NULL) ; TES 3/21/74;
00800 PORINT(PSIX) ← IFIL ; PORSEQ(SEQPORT) ← PIX ; PORSEQ(SEQPORT←PIX) ← 0 ;
00900 NPORTS ← NPORTS + 1 ;
01000 IFC TENEX THENC
01100 INTER ← WRITEON(TRUE, IFILENAME & OCTEXT & IFIL) ;
01200 SINTER← WRITEON(FALSE,IFILENAME & TXTEXT & IFIL) ;
01300 ELSEC
01400 INTER ← WRITEON(TRUE, IFIL & PUIEXT) ; SINTER ← WRITEON(FALSE, IFIL & "S"&PUIEXT) ;
01500 ENDC
01600 END "NOPORTION" ;
00100 PRIVATE PROCEDURE QUICKERSORT(INTEGER J, BASE) ;$"#
00200 BEGIN "QUICKERSORT" comment, Ascending SORT for ALFIZE ;
00300 INTEGER I, K, Q, M, P, T, X ; INTEGER ARRAY UT,LT[1:LOG2(J+2)+1] ;
00400 COMMENT Algorithm 271 (R. S. Scowen) CACM 8,11 (Nov. 1965) pp 669-670 ;
00500 DEFINE A(L) = [ITBL[BASE+L]] ;
00600 LABEL N, L, MM, PP ;
00700 I ← M ← 1 ;
00800 N: IF J-I > 1 THEN
00900 BEGIN
01000 P ← (J+I) DIV 2 ; T ← A(P) ; A(P) ← A(I) ; Q ← J ;
01100 FOR K ← I + 1 THRU Q DO
01200 BEGIN
01300 IF STRLSS(T, A(K)) THEN
01400 BEGIN
01500 FOR Q ← Q DOWN K DO
01600 BEGIN
01700 IF STRLSS(A(Q), T) THEN
01800 BEGIN
01900 A(K) SWAP A(Q) ; Q ← Q - 1 ;
02000 GO TO L ;
02100 END ;
02200 END ;
02300 Q ← K - 1 ;
02400 GO TO MM ;
02500 END ;
02600 L:
02700 END ;
02800 MM:
02900 A(I) ← A(Q) ; A(Q) ← T ;
03000 IF Q+Q > I+J THEN BEGIN LT[M]←I; UT[M]←Q-1; I←Q+1 END
03100 ELSE BEGIN LT[M]←Q+1; UT[M]←J; J←Q-1 END ;
03200 M ← M + 1 ;
03300 GO TO N ;
03400 END
03500 ELSE IF I GEQ J THEN GO TO PP
03600 ELSE BEGIN
03700 IF STRLSS(A(J),A(I)) THEN A(I) SWAP A(J) ;
03800 PP: M ← M - 1 ;
03900 IF M > 0 THEN BEGIN I←LT[M]; J←UT[M]; GO TO N END ;
04000 END ;
04100 END "QUICKERSORT" ;
00100 PUBLIC SIMPLE PROCEDURE RECEIVE(INTEGER PORTIX; STRING ALPHABETIZE) ;$"#
00200 BEGIN "RECEIVE"
00300 INTEGER CH ; STRING FIL ; LABEL TWICE ;
00400 CASE (CH ← PORCH(PORTIX)) + 6 MIN 6 OF
00500 BEGIN
00600 COMMENT -6 ; GO TO TWICE ;
00700 COMMENT -5 Only INSERTed ; IMPOSSIBLE("RECEIVE") ;
00800 COMMENT -4 ; TWICE: WARN(NULL,"Already RECEIVEd generated file for this PORTION") ;
00900 COMMENT -3 ; BEGIN "GENFILE"
01000 FIL ← PORFIL(PORSTR(PORTIX)) IFC NOT TENEX THENC & PUGEXT ENDC ;
01100 IF FULSTR(ALPHABETIZE) THEN BEGIN FIL←ALFIZE(FIL,ALPHABETIZE) ; PORCH(PORTIX)←-6 END
01200 ELSE BEGIN PORCH(PORTIX) ← -4 ; IFC TENEX THENC
01300 FIL←IFILENAME & GENEXT & FIL ENDC END ;
01400 AGENFILE ← TRUE ; SWICHF(FIL) ; PAGESCAN(LAST) ← -PAGESCAN(LAST) ;
01500 END "GENFILE" ;
01600 COMMENT -2 Never SENT ; BEGIN END ;
01700 COMMENT -1 ; BEGIN CH←FOOTSTR(AREAIXM); SWICH(SSTK[CH],-1,0); SSTK[CH]←NULL END ;
01800 COMMENT 0-15 ; IMPOSSIBLE("RECEIVE") ;
01900 END ;
02000 END "RECEIVE" ;
00100 PUBLIC SIMPLE PROCEDURE SEND(INTEGER PORTIX; STRING MESSG) ;$"#
00200 BEGIN "SEND"
00300 INTEGER CH ;
00400 IF 0 LEQ (CH ← PORCH(PORTIX)) THEN OUT(CH,MESSG)
00500 ELSE IF CH=-1 THEN
00600 BEGIN
00700 IF NOPGPH THEN ASSUREAREA ; TES 8/19/74 FIX BUG ;
00800 CH←FOOTSTR(IF AREAIXM THEN AREAIXM ELSE IXTEXT); TES 8/19/74 ;
00900 SSTK[CH]←SSTK[CH]&MESSG ;
01000 END
01100 ELSE WARN(NULL,"Can't send to a passed PORTION:"&MESSG) ;
01200 END "SEND" ;
00100 PUBLIC BOOLEAN SIMPLE PROCEDURE STRLSS(INTEGER XI, YI) ;$"#
00200 BEGIN "STRLSS"
00300 INTEGER XL, YL, MINL, L ; STRING X, Y ;
00400 X ← SSTK[SVSHED + XI] ; Y ← SSTK[SVSHED + YI] ;
00500 XL ← LENGTH(X) ; YL ← LENGTH(Y) ; MINL ← XL MIN YL ;
00600 START!CODE "STRCOM"
00700 LABEL NEXC, SAME, DIFF ;
00800 MOVE 2, X ; MOVE 3, Y ; SKIPN 4, MINL ; JRST SAME ;
00900 NEXC: ILDB 5, 2 ; LDB 5, UPCAS5 ; ILDB 6, 3 ; LDB 6, UPCAS6 ;
01000 CAME 5, 6 ; JRST DIFF ; SOJG 4, NEXC ;
01100 SAME: COMMENT SAME FOR FIRST MINL CHARACTERS ;
01200 MOVE 5, XL ; MOVE 6, YL ; CAME 5, 6 ; JRST DIFF ;
01300 COMMENT AND SAME LENGTH: ; MOVE 5, XI ; MOVE 6, YI ;
01400 DIFF: CAML 5, 6 ; TDZA 1,1 ; MOVEI 1, -1 ; MOVEM 1, L ;
01500 END ;
01600 RETURN(L) ;
01700 END "STRLSS" ;
00100 FINISHED
00200
00300 ENDOF("PORTS")